home *** CD-ROM | disk | FTP | other *** search
- unit dd3graph;
- {Door Driver/3 Generic Graphics Routines}
- interface
- uses dd3ansi,dd3comm,dd3str,dd3time,dd3ini,dd3drop;
- const
- ASCII = 1;
- ANSI = 2;
- AVT = 3; {Not Supported Locally}
- RIP = 4; {Not Supported Locally}
- MAX = 5; {Not Supported Locally}
- var
- graphics : byte;
- textb,textf : byte;
- procedure sgoto_xy(x,y : byte);
- procedure sclrscr;
- procedure sclreol;
- procedure swritexy(x,y : word; s:string);
- procedure set_foreground(f : word);
- procedure set_background(b : word);
- procedure set_color(f,b : word);
- procedure displayfile(filen : string);
- procedure gwrite(s : string);
- procedure dropmessage;
- {function detectgraphics : byte;}
-
- implementation
-
- uses dd3,crt;
-
-
- (*Function RipDetect: boolean;
- var
- i,j,k : integer;
- a : char;
- s : string;
- RipYes : boolean;
- begin
- RipYes := false;
- If local then
- begin
- RipDetect := RipYes;
- exit;
- end;
- gwrite(#27+'[0;30m'+#13+#10);
- writeln;
- writeln('Checking for RIP');
- gwrite(#27'[!');
- delay(222);
- s := '';
- i := 0;
- j := 0;
- charorigin:=localchar;
- repeat;
- a:=chr(0);
- inc(i);
- If (Not AsyncCarrierPresent) then DropMessage;
- a := sread_char;
- if (a<>chr(0)) then
- begin
- s := s+a;
- inc(j);
- end
- else
- begin
- If (i mod 50 = 0) then
- GiveSlice;
- end;
- delay(2);
- until (i>666) or (j>13);
- If Copy(s,1,3) = 'RIP' then
- begin
- RipYes := true;
- writeln('Rip Detected');
- end;
- RipDetect := RipYes;
- Swriteln('');
- end;
-
- function detectgraphics : byte;
- var
- temp : string[60];
- cnt : byte;
- ch : char;
- detectansi : boolean;
- begin
- if local then begin {Check for Local}
- detectgraphics := ANSI;
- exit;
- end;
- gwrite(#27+'[6n');
- repeat
- ch := sread_char;
- if (ch in [#27,'0'..'9','[','H']) then detectansi := true;
- until (skeypressed = false);
- if detectansi then writeln('ANSI Graphics Detected');
- if detectansi then graphics := ANSI;
- if RipDetect then graphics := RIP;
- end;*)
-
- procedure dropmessage;
- begin
- writeln('');
- writeln('');
- writeln('User Has Dropped Carrier - Returning to BBS');
- freeini;
- deletedroplist;
- halt;
- end;
-
- procedure sgoto_xy(x,y : byte);
- begin
- case graphics of
- ASCII : ; {Non Defined}
- ANSI : gwrite(#27+'['+int_to_str(y)+';'+int_to_str(x)+'f');
- AVT : ;
- RIP : ;
- MAX : ;
- end;{case}
- end;
- procedure sclrscr;
- begin
- case graphics of
- ASCII : gwrite(#12);{TTY}
- ANSI : gwrite(#27'[2J');
- AVT : ;
- RIP : ;
- MAX : ;
- end;{case}
- end;
- procedure sclreol;
- begin
- case graphics of
- ASCII : ; {Non Defined}
- ANSI : gwrite(#27'[K');
- AVT : ;
- RIP : ;
- MAX : ;
- end;{case}
- end;
- procedure swritexy(x,y : word; s:string);
- begin
- case graphics of
- ASCII : gwrite(s); {Cursor Positioning Not Availible}
- ANSI : begin
- sgoto_xy(x,y);
- gwrite(s);
- end;
- AVT : ;
- RIP : ;
- MAX : ;
- end;{case}
- end;
- procedure set_foreground(f : word);
- const
- ansif: array[0..7] of string[2] = ('30','34','32','36','31','35','33','37');
- var
- s : string;
- begin
- textf := f;
- case graphics of
- ASCII : textcolor(7);
- ANSI : begin
-
- s := #27'[';
- if (f > 7) and (f < 16) then s := s+';1';
- if (f > 15) and (f <32) then s := s+';5';
- if f > 15 then dec(f,16);
- if f > 7 then dec(f,8);
- s := s + ';'+ansif[f]+'m';
- gwrite(s);
- end;
- AVT : ;
- RIP : ;
- MAX : ;
- end;{case}
- end;
-
- procedure set_background(b :word);
- const
- colorb: array[0..7] of integer = (40,44,42,46,41,45,43,47);
- begin;
- case graphics of
- ASCII : textbackground(0);
- ANSI : begin
- if b > 7 then exit;
- if (textf=7) and (b=0) then
- gwrite(#27+'[0m')
- else
- gwrite(#27+'['+int_to_str(colorb[b])+'m');
- textb := b;
- end;
- AVT : ;
- MAX : ;
- RIP : ;
- end; {case}
- end;
- procedure set_color(f,b : word);
- begin
- textf := f;
- textb := b;
- set_foreground(f);
- set_background(b);
- end;
- procedure gwrite(s : string);
- begin
- if not local then if asynccarrierpresent = false then dropmessage;
- case graphics of
- ASCII : begin
- write(s);
- if not local then asyncsendstr(s);
- end;
- ANSI : begin
- ansi_write_str(s);
- if not local then asyncsendstr(s);
- end;
- AVT : begin
- write(s);
- if not local then asyncsendstr(S);
- end;
- RIP : begin
- write(s);
- if not local then asyncsendstr(s);
- end;
- MAX : begin
- write(s);
- if not local then asyncsendstr(s);
- end;
- else begin
- write(s);
- if not local then asyncsendstr(s);
- end;
- end;{case}
- giveslice;
- end;
-
- procedure displayfile(filen : string);
- var f : text;
- temp : string;
- begin
- assign(f,filen);
- {$I-}reset(f);{$I+}
- if ioresult = 0 then begin
- while not eof(F) do
- begin
- readln(f,temp);
- gwrite(temp+#13#10);
- end;{While}
- close(f);
- end;{ioresult}
- set_color(textf,textb);
- end;
-
- begin
- textf := 7; {For Ground}
- textb := 0; {Background}
- end.